perm filename SAISER.SAI[SYS,HE]4 blob
sn#050980 filedate 1973-06-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SAISER - service-routines
C00005 00003 _ MAPCONV
C00007 00004 _ INITIA, TELL, UNTELL, OPLPT
C00009 00005 _ PL, TTIN, EDGPRT
C00011 00006 _ QSET, QRSET, QREAD
C00013 00007 _ SETPAR
C00016 00008 _ COMST
C00018 00009 _ REGREF
C00022 00010 _ XREFC
C00024 00011 _ EXPL, BITS, SHUFFL
C00029 ENDMK
C⊗;
COMMENT SAISER - service-routines;
ENTRY INITIA,TELL,UNTELL,PL,TTIN,QSET,QRSET,QREAD,
SETPAR,COMST,OPLPT,REGREF,XREFC,EXPL,BITS,SHUFFL;
BEGIN "SAISER"
DEFINE CL="'15&'12",
BL="'40",
PG="'14&'15",
_="COMMENT",
QRETURN="BEGIN UNTELL; RETURN END",
LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
QI="INTEGER",
QEP="EXTERNAL SIMPLE PROCEDURE",
QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
NUMI="CVD(QREAD)",
SAFEX="SAFE";
EXTERNAL STRING H,JUNKSTR,COMSTR,NAME;
EXTERNAL REAL RDEP,RMEDA,SHRINK,RDDP,RDNP,RMSD,RMLG,RWIC,RMLE,RCDI,RMALS,
RMRLS,RDUM,RMSAF,RMAP;
EXTERNAL INTEGER IDUM,IA,IB,IC,ID,BRCHAR,EO,NLPT,IWHAT,NPAR,NOEPL,NOEPM,
NOEPA,NOL,NOV,IFREEL,IFREEV,MAXNOL,MSAFA,NOBAL,MAXNOV,
LDATE,ILLL,ILFL,MODE,MTRACE,MEOF,CFILES;
SAFEX EXTERNAL STRING ARRAY CMSTRS[0:9],CMSAV[1:10];
SAFEX EXTERNAL INTEGER ARRAY LE,LEDG1,LEDG2,LCREDE,LVERSI,LVERCO,LVER,
MCHN,LINK[1:1];
SAFEX EXTERNAL REAL ARRAY XVCOR,YVCOR,SVANG,XLCOR,YLCOR,EAX,EAY,EBX,EBY,
CXL,CYL,CCL,RLEN,ANGARG[1:1];
QEIP ISIGN(QI I,J);
QEIP LACT(QI I);
QEP XREF;
FORWARD INTERNAL SIMPLE STRING PROCEDURE QREAD;
_ MAPCONV;
_ decode trace codes for parser and encode bits;
INTERNAL INTEGER PROCEDURE MAPCONV(STRING CODES);
BEGIN DEFINE NUMB="13";
PRELOAD_WITH "NR","OV","PM","BM","BP","TT","TD","PK","TL","OD",
"SK","SI","PR";
OWN SAFEX STRING ARRAY COD[1:NUMB];
PRELOAD_WITH 1,4,'20,'100,'400,'2000,'10000,'20000,'40000,'100000,
'200000,'1000000,'4000000;
OWN SAFEX INTEGER ARRAY BIT[1:NUMB];
STRING PARS, REJ;
INTEGER LAST, I, VAL;
LABEL L;
L: LAST ← VAL ← 0;
REJ ← NULL;
IF EQU(CODES,"RESET") THEN RETURN(-1);
IF EQU(CODES,"NULL") THEN RETURN(0);
WHILE LENGTH(CODES) DO
BEGIN "MAPA"
PARS ← CODES[1 FOR 2];
CODES ← CODES[3 FOR ∞];
IF EQU(PARS,"PI")∧LAST∧¬('10000≤LAST≤'100000)∧LAST≠'4000000
THEN BEGIN "MAPB"
VAL ← VAL LOR (LAST LSH 1);
CONTINUE;
END "MAPB";
FOR I←1 STEP 1 UNTIL NUMB DO IF EQU(PARS,COD[I]) THEN DONE;
IF I=NUMB+1 THEN REJ←REJ&PARS&" " ELSE
VAL ← VAL LOR(LAST←BIT[I]);
END "MAPA";
IF LENGTH(REJ) THEN
BEGIN "MAPC"
OUTSTR("CODES NOT RECOGNIZED:"&REJ&CL&"RETYPE:");
CLRBUF;
CODES ← INCHWL;
GO TO L;
END "MAPC";
RETURN(VAL);
END "MAPCONV";
_ INITIA, TELL, UNTELL, OPLPT;
_ Initializes the data structure (free storage pointers, etc.);
INTERNAL SIMPLE PROCEDURE INITIA;
BEGIN "INITIA"
INTEGER I,J,K,L;
IFREEL←IFREEV←0;
IF NOL<MAXNOL THEN
BEGIN
LOOP(I,NOL+1,MAXNOL,1)
BEGIN
J←2*I;
LOOP(K,-1,0,1) LVERCO[L←J+K]←LVER[L]←LINK[L]←0;
LEDG1[I]←LEDG2[I]←0;
LCREDE[I]←-1001-I
END;
LCREDE[MAXNOL]←-1000;
IFREEL←NOL+1;
END;
IF NOV<MAXNOV THEN
BEGIN
LOOP(I,NOV+1,MAXNOV,1) LVERSI[I]←-1001-I;
LVERSI[MAXNOV]←-1000;
IFREEV←NOV+1;
END
END "INITIA";
_ Types out what the program is currently involved with;
INTERNAL SIMPLE PROCEDURE TELL(STRING WHAT);
IF IWHAT THEN OUTSTR(" ["&WHAT);
_ Types end-indication of current "tell"-typeout;
INTERNAL SIMPLE PROCEDURE UNTELL;
IF IWHAT THEN OUTSTR("]");
_ Checks if lpt is open (opens if necessary);
INTERNAL SIMPLE PROCEDURE OPLPT;
BEGIN "OPLPT"
EO←1;
OPEN(4,"DSK",0,0,2,120,BRCHAR,EO);
IF EO THEN RETURN;
ENTER(4,NAME&NLPT&".LPT",IDUM);
NLPT←NLPT+1
END "OPLPT";
_ PL, TTIN, EDGPRT;
_ Returns S1, preceded by enough S2:s to make the total length = I;
INTERNAL SIMPLE STRING PROCEDURE PL(STRING S1,S2; INTEGER I);
BEGIN "PL"
INTEGER J,K;
STRING SRET;
K←LENGTH(SRET←S1);
FOR J←1 STEP 1 UNTIL I-K DO SRET←S2&SRET;
RETURN(SRET)
END "PL";
_ Inputs next string from tty;
INTERNAL SIMPLE STRING PROCEDURE TTIN;
BEGIN "TTIN"
LABEL BA1;
TELL("tty wait: ");
BA1: JUNKSTR←TTYIN(13,BRCHAR);
IF BRCHAR="?"∨EQU(JUNKSTR,NULL)∧BRCHAR≠'12 THEN GO BA1;
UNTELL;
RETURN(JUNKSTR)
END "TTIN";
_ Prints edge point data;
INTERNAL SIMPLE PROCEDURE EDGPRT;
BEGIN "EDGPRT"
TELL("EDGE-PRINT");
OPLPT;
IF EO THEN RETURN;
OUT(4,"EDGE POINTS FOR SCENE "&NAME&CL&CL);
SETFORMAT(15,5);
OUT(4," I EAX[I] EAY[I] EBX[I]"&
" EBY[I] LE[I]"&CL&CL);
LOOP(IA,1,NOEPA,1) OUT(4,CVS(IA)&CVF(EAX[IA])&CVF(EAY[IA])&
CVF(EBX[IA])&CVF(EBY[IA])&CVS(LE[IA])&CL);
RELEASE(4);
UNTELL;
SETFORMAT(0,2);
END "EDGPRT";
_ QSET, QRSET, QREAD;
_ To show and set integer parameters;
INTERNAL SIMPLE INTEGER PROCEDURE QSET(REFERENCE INTEGER I);
BEGIN "QSET"
IF ¬MODE THEN OUTSTR(" = "&CVS(I)&" ← ");
RETURN(I←NUMI)
END "QSET";
_ To show and set real parameters;
INTERNAL SIMPLE REAL PROCEDURE QRSET(REFERENCE REAL R);
BEGIN "QRSET" STRING TEMP;
IF ¬MODE THEN OUTSTR(" = "&CVF(R)&" ← ");
TEMP ← QREAD;
RETURN(R←REALSCAN(TEMP,IDUM));
END "QRSET";
_ Inputs next string from COMSTR or TTY;
INTERNAL SIMPLE STRING PROCEDURE QREAD;
BEGIN "QREAD"
STRING S;
LABEL BA1,BA2,OUT1,ON1;
IF ¬MODE THEN RETURN(TTIN);
BA1: IF CFILES∧COMSTR=0 THEN
BEGIN
S←INPUT(MCHN[CFILES],13);
IF MEOF∨BRCHAR="⊗" THEN
BEGIN
COMSTR←CMSAV[CFILES];
RELEASE(MCHN[CFILES]);
CFILES←CFILES-1
END;
GO ON1
END;
BA2: S←SCAN(COMSTR,13,BRCHAR);
ON1: IF S≠0 THEN GO OUT1;
IF COMSTR≠0 THEN GO BA2;
IF CFILES THEN GO BA1;
MODE←0;
BRCHAR←'12;
OUT1: IF MTRACE THEN OUTSTR("="&S&(IF BRCHAR='12 THEN ";" ELSE BRCHAR));
RETURN(S)
END "QREAD";
_ SETPAR;
_ This is the parameter editor;
INTERNAL SIMPLE PROCEDURE SETPAR;
BEGIN "SETPAR"
STRING PAR;
INTEGER I,J;
REAL VAL;
LABEL BA1,BA2,OUT1,ON1;
PRELOAD_WITH "NOEPL","NOEPM","NOEPA","NOL","NOV",
"IFREEL","IFREEV","MAXNOL","MSAFA","MSAFR",
"NOBAL","MAXNOV","LDATE","RDEP","RMEDA","SHRINK",
"RDDP","ILLL","ILFL","RDNP","RMSD","RMLG","RWIC","RMLE",
"RCDI","RMALS","RMRLS","RMAP";
OWN SAFEX STRING ARRAY PARNAM[1:40];
PRELOAD_WITH [13]0,[4]1,0,0,[9]1;
OWN SAFEX INTEGER ARRAY PARTYP[1:40];
TELL("param-ed");
BA1: PAR←QREAD;
BA2: IF EQU(PAR,"E") THEN GO OUT1;
I←1;
WHILE I≤NPAR∧¬EQU(PARNAM[I],PAR) DO I←I+1;
IF I>NPAR THEN BEGIN OUTSTR(" WHAT?"&CL); GO BA1 END;
VAL←CASE I OF(1.0,NOEPL,NOEPM,NOEPA,NOL,NOV,IFREEL,
IFREEV,MAXNOL,MSAFA,RMSAF,NOBAL,MAXNOV,LDATE,RDEP,RMEDA,
SHRINK,RDDP,ILLL,ILFL,RDNP,RMSD,RMLG,RWIC,RMLE,RCDI,
RMALS,RMRLS,RMAP);
OUTSTR((IF MODE THEN PAR ELSE NULL)&" = "&
(IF PARTYP[I] THEN CVF(VAL) ELSE CVS(VAL))&" ");
IF BRCHAR="←" THEN GO ON1;
PAR←QREAD;
IF EQU(PAR,NULL) THEN GO BA1;
IF ¬EQU(PAR,"←") THEN GO BA2;
ON1: IF PARTYP[I] THEN
BEGIN STRING TEMP;
TEMP ← QREAD;
VAL←REALSCAN(TEMP,IDUM);
END ELSE J←NUMI;
CASE I OF
BEGIN
;;;
NOEPA←J;
;;;;;;;;
MSAFA←J;
RMSAF←VAL;
;;
LDATE←J;
RDEP←VAL;
RMEDA←VAL;
SHRINK←VAL;
RDDP←VAL;
ILLL←J;
ILFL←J;
RDNP←VAL;
RMSD←VAL;
RMLG←VAL;
RWIC←VAL;
RMLE←VAL;
RCDI←VAL;
RMALS←VAL;
RMRLS←VAL;
RMAP←VAL
END;
GO BA1;
OUT1: UNTELL
END "SETPAR";
_ COMST;
_ Shows (changes) command strings;
INTERNAL SIMPLE PROCEDURE COMST;
BEGIN "COMST"
QI IA;
LABEL LOP,OUT,INP;
IA←0;
TELL("command editor");
LOP: OUTSTR(CL&CVS(IA)&": "&CMSTRS[IA]);
H←QREAD;
IF H="E" THEN GO OUT;
IF H="←" THEN GO INP;
IA←9 MIN (0 MAX CVD(H));
GO LOP;
INP: CMSTRS[IA]←NULL;
WHILE BRCHAR≠"*" DO
BEGIN
JUNKSTR←QREAD&"*";
IF BRCHAR≠"?" THEN CMSTRS[IA]←CMSTRS[IA]&JUNKSTR
END;
GO LOP;
OUT: UNTELL
END "COMST";
_ REGREF;
_ Prints the main features of the datastructure;
INTERNAL SIMPLE PROCEDURE REGREF(INTEGER I);
BEGIN "REGREF" LABEL ON1,ON2;
TELL("ref-tables");
OPLPT;
IF EO THEN QRETURN;
OUT(4,"Data structure map for scene "&NAME&CL&CL);
SETFORMAT(0,1);
IF ¬(I MOD 10) THEN GO ON1;
OUT(4,"Line-data:"&CL&CL);
OUT(4,"LIN XLCOR YLCOR XLCOR YLCOR CXL CYL CCL RLEN "
&"ANGARG LINK1 LINK2 LEDG1 LEDG2 LCREDE");
LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
BEGIN
IB←2*IA;
IC←IB-1;
OUT(4,CL&CL&PL(CVS(IA),BL,3)&PL(CVF(XLCOR[IC]),BL,7)&
PL(CVF(YLCOR[IC]),BL,6)&PL(CVF(XLCOR[IB]),BL,7)&
PL(CVF(YLCOR[IB]),BL,6)&PL(CVF(CXL[IA]),BL,6)&
PL(CVF(CYL[IA]),BL,5)&PL(CVF(CCL[IA]),BL,7)&
PL(CVF(RLEN[IA]),BL,7)&PL(CVF(ANGARG[IA]),BL,7)&
PL(CVS(LINK[IC]),BL,6)& PL(CVS(LINK[IB]),BL,6)&
PL(CVS(LEDG1[IA]),BL,6)&PL(CVS(LEDG2[IA]),BL,6)&
PL(CVS(LCREDE[IA] LAND '7777),BL,7))
END;
OUT(4,PG);
ON1: IF ¬((I←I%10) MOD 10) THEN GO ON2;
OUT(4,CL&"Vertex (s.v. and c.v.) data:"&CL&CL);
OUT(4,PL("SV",BL,4)&PL("LINE",BL,9)&PL("LCREDE",BL,9)&
" LVER SVANG LVERCO"&PL("CV",BL,20)&
" XVCOR YVCOR LVERSI");
LOOP(IA,1,MAXNOV,1) IF LVER[IA]∨LVERSI[IA]>-1000 THEN
OUT(4,CL&CL&(IF LVER[IA] THEN
PL(CVS(IA),BL,4)&PL(CVS((IA+1)%2),BL,9)&
PL(CVS(LCREDE[(IA+1)%2] LAND '7777),BL,9)&
PL(CVS(LVER[IA]),BL,8)&PL(CVF(SVANG[IA]),BL,8)&
PL(CVS(LVERCO[IA]),BL,8) ELSE PL(NULL,BL,46))&
(IF LVERSI[IA]>-1000 THEN
PL(CVS(IA),BL,20)&PL(CVF(XVCOR[IA]),BL,10)&
PL(CVF(YVCOR[IA]),BL,7)&PL(CVS(LVERSI[IA]),BL,10)
ELSE NULL));
ON2: UNTELL;
RELEASE(4);
SETFORMAT(0,2)
END "REGREF";
_ XREFC;
_ Calls XREF with auxilliary arrays. Prints tables iff IE is on;
INTERNAL PROCEDURE XREFC(INTEGER IE);
BEGIN "XREFC"
SAFEX INTERNAL INTEGER ARRAY IPK,IPS[1:MAXNOV];
SAFEX INTERNAL REAL ARRAY RK,RBK,RAS,RBS,RCOL[1:MAXNOV];
TELL("xref");
XREF;
UNTELL;
IF ¬IE THEN RETURN;
TELL("+PRINT");
OPLPT;
IF EO THEN QRETURN;
OUT(4,"Line-intersection cross-reference tables for scene "&
NAME&CL&CL);
SETFORMAT(0,1);
OUT(4,PL("SV",BL,4)&PL("LINE",BL,9)&PL("LCREDE",BL,9)&
PL("RCRO",BL,12)&PL("RBCRO",BL,12)&PL("SVCRO",BL,8)&
PL("RINT1",BL,12)&PL("RINT2",BL,10)&PL("SVINT",BL,8)&
PL("RCOL",BL,12)&PL("LINK",BL,8));
LOOP(IC,1,MAXNOL,1) IF LACT(IC) THEN
BEGIN
IB←2*IC;
OUT(4,CL);
LOOP(ID,IB-1,IB,1) OUT(4,CL&PL(CVS(ID),BL,4)&
PL(CVS(IC),BL,9)&PL(CVS(LCREDE[IC]),BL,9)&
PL(CVF(RK[ID]),BL,12)&PL(CVF(RBK[ID]),BL,12)&
PL(CVS(IPK[ID]),BL,8)&PL(CVF(RAS[ID]),BL,12)&
PL(CVF(RBS[ID]),BL,10)&PL(CVS(IPS[ID]),BL,8)&
PL(CVF(RCOL[ID]),BL,12)&PL(CVS(LINK[ID]),BL,8))
END;
RELEASE(4);
SETFORMAT(0,2);
UNTELL
END "XREFC";
_ EXPL, BITS, SHUFFL;
_ Explodes the word WD into decimal parts, partitioned after each
position indicated by a bit in the word BARS, by the corresponding
character in CHARS. Exploded word will be surrounded by first and
last characters of CHARS.;
INTERNAL SIMPLE STRING PROCEDURE EXPL(INTEGER WD,BARS; STRING CHARS);
BEGIN "EXPL"
STRING S;
INTEGER IA,IB;
S←LOP(CHARS);
IB←0;
LOOP(IA,1,36,1)
BEGIN
IB←(IB LSH 1) LOR (IF WD<0 THEN 1 ELSE 0);
IF BARS<0 THEN BEGIN S←S&CVS(IB)&LOP(CHARS); IB←0; END;
WD←WD LSH 1;
BARS←BARS LSH 1
END;
RETURN(S)
END "EXPL";
_ Returns bits IA through IB (IA≤IB) of the fullword WD, right adjusted;
INTERNAL SIMPLE INTEGER PROCEDURE BITS(INTEGER WD,IA,IB);
RETURN((WD LSH(35-IB)) LSH (IB-35-IA));
_ Shuffles the line-dimensioned data-space into a contiguous block
at lower end of storage (for save and/or expansions-contractions);
INTERNAL SIMPLE PROCEDURE SHUFFL;
BEGIN "SHUFFL"
LABEL BA1,ON1,BA2,BA3;
INTEGER TO,FROM,ITO,IFROM,IA;
DEFINE MV(I)="I[TO]←I[FROM]",
MO(I)="I[ITO]←I[IFROM]",
TM(I)="IF ABS I[IB]=IFROM THEN I[IB]←ISIGN(ITO,I[IB])";
TELL("shuffle");
TO←1;
WHILE TO<MAXNOL∧LCREDE[TO]>-1000 DO TO←TO+1;
IF TO=MAXNOL THEN GO ON1;
FROM←TO+1;
BA1: WHILE FROM≤MAXNOL∧LCREDE[FROM]≤-1000 DO FROM←FROM+1;
IF FROM>MAXNOL THEN GO ON1;
MV(LEDG1);
MV(LEDG2);
MV(LCREDE);
MV(CXL);
MV(CYL);
MV(CCL);
MV(RLEN);
MV(ANGARG);
LCREDE[FROM]←-1000;
LOOP(IA,-1,0,1)
BEGIN
ITO←2*TO+IA;
IFROM←2*FROM+IA;
MO(SVANG);
MO(XLCOR);
MO(YLCOR);
MO(LVERCO);
MO(LINK);
MO(LVER);
LOOP(IB,1,MAXNOV,1)
BEGIN
TM(LINK);
TM(LVER);
TM(LVERSI)
END
END;
IF(TO←TO+1)<MAXNOL THEN GO BA1;
_ All the line-data has now been shuffled and re-referenced.
Do the same for compound vertices;
ON1: TO←1;
WHILE TO<MAXNOV∧LVERSI[TO]>-1000 DO TO←TO+1;
IF TO=MAXNOV THEN GO BA3;
FROM←TO+1;
BA2: WHILE FROM≤MAXNOV∧LVERSI[FROM]≤-1000 DO FROM←FROM+1;
IF FROM>MAXNOV THEN GO BA3;
MV(XVCOR);
MV(YVCOR);
MV(LVERSI);
LVERSI[FROM]←-1000;
LOOP(IB,1,MAXNOV,1) IF LVERCO[IB]=FROM THEN LVERCO[IB]←TO;
IF(TO←TO+1)<MAXNOV THEN GO BA2;
BA3: UNTELL;
END "SHUFFL";
END "SAISER";